home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / MAIL.SWG / 0002_Handling FIDO Messages.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  11.0 KB  |  355 lines
  1. {
  2.  WK> I was wondering if anyone has either the layout for a *.MSG
  3.  WK> packet or knows of a unit to generate and process *.MSG packets.
  4. }
  5.  
  6. unit fidomsg;  { See 2 demo programs attached below !! }
  7. Interface
  8. uses dos;
  9. const
  10.   MsgSize = 32768;
  11. type
  12. AddressType = record
  13.                 Zone  : Byte;
  14.                 Net   : Word;
  15.                 Node  : Word;
  16.                 Point : Word;
  17.                 Domain: String[15];
  18.               end;
  19.  
  20. TxtPtrType = ^TxtRecType;
  21. TxtRecType = array[1..MsgSize] of char;
  22.  
  23. String36    = string[36];
  24. String72    = string[72];
  25. String20    = string[20];
  26. FMsgType =    record
  27.                 FromUserName : String36;
  28.                 ToUserName   : String36;
  29.                 Subject      : String72;
  30.                 DateTime     : String20;
  31.                 Origin       : AddressType;
  32.                 Destination  : AddressType;
  33.                 NextReply    : word;
  34.                 MsgTxtPtr    : TxtPtrType;
  35.               end;
  36.  
  37. procedure LoadMsg(var Msg: FMsgType; MsgFilePath : PathStr; var Result: byte);
  38. procedure GetMsgHeap    (var Msg: FMsgType);
  39. procedure DisposeMsgHeap(var Msg: FMsgType);
  40.  
  41.  Implementation
  42.  
  43. procedure GetMsgHeap(var Msg: FMsgType);
  44. begin
  45.   New(Msg.MsgTxtPtr);
  46. end;
  47.  
  48. procedure DisposeMsgHeap(var Msg: FMsgType);
  49. begin
  50.   Dispose(Msg.MsgTxtPtr);
  51. end;
  52.  
  53. procedure LoadMsg(var Msg: FMsgType; MsgFilePath : PathStr; var Result: byte);
  54.  
  55. type
  56.   MsgHeaderType =    record
  57.                        HFromUserName : array[1..36] of char;
  58.                        HToUserName   : array[1..36] of char;
  59.                        HSubject      : array[1..72] of char;
  60.                        HDateTime     : array[1..20] of char;
  61.                        HTimesRead    : word;
  62.                        HDestNode     : word;
  63.                        HOrigNode     : word;
  64.                        HCost         : word;
  65.                        HOrigNet      : word;
  66.                        HDestNet      : word;
  67.                        HFiller       : array[1..8] of char;
  68.                        HReplyto      : word;
  69.                        HAttribute    : word;
  70.                        HNextReply    : word;
  71.                       end;
  72. var
  73.   i : word;
  74.   ReadResult : word;
  75.   MsgFile : file;
  76.   MsgHead : MsgHeaderType;
  77. begin
  78.   assign(MsgFile,MsgFilePath);
  79.   {$I-}
  80.   reset(MsgFile,1);
  81.   {$I+}
  82.   Result := IoResult;
  83.   if result>0 then exit;
  84.   fillchar(MsgHead,SizeOf(MsgHead),#00);
  85.   fillchar(Msg.MsgTxtPtr^,MsgSize,#00);
  86.   BlockRead(MsgFile,MsgHead,Sizeof(MsgHead));           {Read Header Info}
  87.   BlockRead(MsgFile,Msg.MsgTxtPtr^,MsgSize,ReadResult); {Read Msg Text}
  88.   If ReadResult = MsgSize then
  89.   begin
  90.     result := 255; {Msg > MsgSize}
  91.     exit;
  92.   end;
  93.   with Msg, MsgHead do
  94.   begin
  95.     for i := 1 to 36 do
  96.     begin
  97.       if HFromUserName[i] = #00 then
  98.       begin;
  99.         FromUserName[0] := chr(i-1);
  100.         i := 36;
  101.       end;
  102.       FromUserName[i] := HFromUserName[i];
  103.     end;
  104.     for i := 1 to 36 do
  105.     begin
  106.       if HToUserName[i]   = #00 then
  107.       begin
  108.         ToUserName[0] := chr(i-1);
  109.         i := 36;
  110.       end;
  111.       ToUserName[i] := HToUserName[i];
  112.     end;
  113.     for i := 1 to 72 do
  114.     begin
  115.       if HSubject[i] = #00 then
  116.       begin
  117.         Subject[0] := chr(i-1);
  118.         i := 72;
  119.       end;
  120.       Subject[i] := HSubject[i];
  121.     end;
  122.     for i := 1 to 20 do
  123.     begin
  124.       if HDateTime[i] = #00 then
  125.       begin
  126.         DateTime[0] := chr(i-1);
  127.         i := 20;
  128.       end;
  129.       DateTime[i] := HDateTime[i];
  130.     end;
  131.     Destination.Zone := 1;
  132.     Destination.Node := HDestNode;
  133.     Destination.Net  := HDestNet;
  134.     Destination.Point := 0;
  135.     Origin.Zone := 1;
  136.     Origin.Node      := HOrigNode;
  137.     Origin.Net       := HOrigNet;
  138.     Origin.Point := 0;
  139.     NextReply        := HNextReply;
  140.   end;
  141.   close(MsgFile);
  142. end;
  143. end.
  144.  
  145. { --------------------   DEMO PROGRAM --------------------- }
  146.  
  147. program DELMSGBY; { A program to kill all FIDOnet messages by a
  148.                     certain person }
  149.  
  150. {$M 16384,0,65536}
  151.  
  152. uses dos,fidomsg;
  153.  
  154. var foo      :byte;
  155.     nametodel:string;
  156.     msg      :FMsgType;
  157.     s        :searchrec;
  158.  
  159. function upstr(st:string):string;                { string processor that   }
  160. var a:string;                                    { makes all uppercase and }
  161. begin                                            { removes spaces          }
  162.    a:='';
  163.    for foo:=1 to length(st) do
  164.    begin
  165.       If st[foo]<>#32 then a:=a+upcase(st[foo]);
  166.    end;
  167.    upstr:=a;
  168. end;
  169.  
  170. begin
  171.    if paramcount<1 then          { If they don't know how to use this, then }
  172.    begin
  173.       writeln;
  174.       writeln(' Usage: DELMSGBY [firstname] [lastname]');   { Tell them     }
  175.       writeln;
  176.    end
  177.    else                       { Otherwise, they DO know how to use this, so }
  178.    begin
  179.       nametodel:='';
  180.       for foo:=1 to paramcount do          { Get the name they don't like}         nametodel:=nametodel+' '+paramstr(foo);
  181.       findfirst('*.MSG',Anyfile,s);        { And search all .MSG files for it}      while (DosError=0) do                { If a file is found then}      begin
  182.          GetMsgHeap(msg);                     { Make space on the heap for it}         loadmsg(msg,fexpand(s.name),foo);    { Load it }
  183.          If (upstr(msg.FromUserName)=upstr(nametodel)) then
  184.          begin                           { If the message if from the bad guy}            swapvectors;                 {     then delete it. I used EXEC so}            exec(getenv('COMSPEC'),' /C '+'Del '+fexpand(s.name)); { you can}            swapvectors;                 { easily move, or rename it.}            writeln('Deleting '+fexpand(s.name)+'. It''s Contaminated!');
  185.          end;
  186.          DisposeMsgHeap(msg);            { Done w/ that message, so take back}         findnext(s);                    { the heap space. Then find another}      end;                               { Message to check. }
  187.    end;
  188. end.
  189.  
  190. { ---------------------------   DEMO PROGRAM ----------------------------}
  191.  
  192. {this is a stand alone *.msg reader}
  193. uses dos,crt;
  194. Type FidoHeader=record {structure of the Message Header}
  195.         WhoTheMessageIsFrom,
  196.         WhoTheMessageItTo   : Array[1..36] of Char; {ASCIIZ Strings}
  197.         MessageSubject      : Array[1..72] of Char;
  198.         MessageDate         : Array[1..20] of Char;
  199.                 {The Message Date is an ASCIIZ string following this
  200.                 format: DD MMM YY  HH:MM:SS<Null>-20 Characters Total
  201.                 Example: 01 Jun 94 20:00:00 is June 1st 1994 at 8:00PM
  202.                 But SeaDog uses a slightly different version and you
  203.                 might want to account for that, unfortunately I can't
  204.                 remember the exact format, also SLMAIL for SearchLight
  205.                 BBS only puts one space between the year and the hour
  206.                 even though it's supposed to be 2, I'm surprised this
  207.                 hasn't thrown mailers of other BBS programs}
  208.         TimesTheMessageWasRead,
  209.         DestinationNode,
  210.         OriginalNode,
  211.         CostofTheMessage,
  212.         OriginalNet,
  213.         DestinationNet      : Integer;
  214.                 {Note: TimesTheMessageWasRead & CostofTheMessage are
  215.                 usually ignored when being exported from the BBS and can
  216.                 be ignored when importing into a BBS}
  217.         DateWritten,
  218.         DateArrived         : LongInt;
  219.                 {I'm not sure how the dates are stored in here, but
  220.                 they're usually ignored}
  221.         MessageToWhichThisRepliesTo: Integer;{Irrevelant over a network}
  222.         Arrtibutes          : Word;
  223.                 {Bit Field:
  224.                     Bit 0 Private Message
  225.                         1 Crashmail
  226.                         2 Message Was Read
  227.                         3 Message Was Sent
  228.                         4 File Attatched, Filename in subject
  229.                         5 Forwarded Message
  230.                         6 Orphan Message ???
  231.                         7 Kill After Its Sent (I think)
  232.                         8 Message Originated Here (local)
  233.                         9 Hold
  234.                         10 Reserved
  235.                         11 File Request, Filenames in Subject
  236.                         12 Return Receipt Requested
  237.                         13 This message is a Return Receipt
  238.                         14 Audit Trail Requested
  239.                         15 Update Request }
  240.         UnReply             : Integer; {I have No Idea}
  241. End;
  242.  
  243. Type FidoMsg=record
  244.    msgchar : char;
  245. end;
  246.  
  247. {The Message Text follows terminated by either a Null (#0) or to Cr's #13#13.
  248. Also all paragraphs are supposed to end with a Hard CR (#141) and you can
  249. ignoreany #13 and reformat the text for your own program, also any lines
  250. starting with^A (#1) should not be imported into the BBS, they are control
  251. lines... thecontents of these lines varies so you'll have to find out that on
  252. your own }
  253. var
  254.   header : fidoheader;
  255.   headerf: file of fidoheader;
  256.   MsgTxt : FidoMsg;
  257.   MsgTxtf: file of FidoMsg;
  258.   DirInfo: SearchRec;
  259.   ch,cx : char;
  260.   cr,count : shortint;
  261.   i:byte;
  262.   l : string;
  263.   s : string;
  264.   howlong : byte;
  265. begin
  266.   FindFirst('*.MSG', Archive, DirInfo);
  267.   while DosError = 0 do
  268.   begin
  269.     window(1,1,80,25);
  270.     clrscr;
  271.     textcolor(lightgreen);
  272.     WriteLn(DirInfo.Name);
  273.     textcolor(green);
  274.     assign(headerf,DirInfo.Name);
  275.     reset(headerf);
  276.     read(headerf,header);
  277.     with header do
  278.     begin
  279.         Writeln('From:  ',WhoTheMessageIsFrom);
  280.         Writeln('To  :  ',WhoTheMessageItTo);
  281.         Writeln('Subj:  ',MessageSubject);
  282.         Writeln('Date:  ',MessageDate);
  283.     end;
  284.     textcolor(white);
  285. Writeln('═════════════════════════════════════════════════════════════════════
  286. ═ ══════');    window(1,wherey,80,25);
  287.     textcolor(cyan);
  288.     close(headerf);
  289.     assign(MsgTxtF,DirInfo.Name);
  290.     reset(MsgTxtF);
  291.     seek(MsgTxtF,sizeof(header));
  292.     cr := 0;
  293.     count := 0;
  294.     l := '';
  295.     repeat
  296.       read(MsgTxtF,MsgTxt);
  297.       ch := MsgTxt.msgchar;
  298.       if not (ch in [#10,#13]) then
  299.       begin
  300.         l := l + ch;
  301.         howlong := length(l);
  302.       end;
  303.       if keypressed then
  304.       begin
  305.         cx := readkey;
  306.         if cx = #27 then halt;
  307.       end;
  308.       if length(l) > 78 then
  309.       begin
  310.         count := length(l);
  311.         while (count > 60) and (l[count] <> ' ') do dec(count);
  312.         writeln(l,copy(l,1,count));
  313.         delete(l,count,length(l));
  314.       end;
  315.       if ch = #13 then
  316.       begin
  317.         writeln(l);
  318.         l := '';
  319.         howlong := 0;
  320.       end;
  321.       if pos('these things?',l) > 0 then
  322.       begin
  323.         write
  324.       end;
  325.       if wherey > 15 then
  326.       begin
  327.         textcolor(12);
  328.         writeln;
  329.  
  330.         write('Press enter: ');
  331.         readln;
  332.  
  333.         clrscr;
  334.         textcolor(cyan);
  335.       end;
  336.  
  337.     until eof(MsgTxtF) or (ioresult > 0);
  338.     if l > '' then
  339.     begin
  340.       writeln(l);
  341.       l := '';
  342.     end;
  343.     textcolor(11);
  344.     write('End of Msg: ');
  345.     textcolor(7);
  346.     cx := readkey;
  347.     if cx = #27 then halt;
  348.     clrscr;
  349.     FindNext(DirInfo);
  350.   end;
  351.   textcolor(7);
  352. end.
  353.  
  354. end.
  355.